unit QuickList_DealClass;

interface
            
{$IFDEF DEALCLASS}
uses
  QuickSortList,
  define_stockclass;
  
type       
  PDealClassListItem = ^TDealClassListItem;
  TDealClassListItem = record
    DBId      : integer;
    DealClass : PRT_ClassDef_Rec;
  end;
                        
  TDealClassList = class(TALBaseQuickSortList)
  public
    function  GetItemKey(AIndex: Integer): Integer;
    procedure SetItemKey(AIndex: Integer; const ADbId: Integer);
    function  GetDealClass(Index: Integer): PRT_ClassDef_Rec;
    procedure PutDealClass(Index: Integer; ADealClass: PRT_ClassDef_Rec);
  public
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    procedure InsertItem(Index: Integer; const ADBId: integer; ADealClass: PRT_ClassDef_Rec);
    function  CompareItems(const Index1, Index2: Integer): Integer; override;
  public
    function  IndexOf(ADBId: Integer): Integer;
    function  IndexOfDealClass(ADealClass: PRT_ClassDef_Rec): Integer;
    Function  AddDealClass(const ADBId: integer; ADealClass: PRT_ClassDef_Rec): Integer;
    function  FindIndex(ADBId: Integer; var Index: Integer): Boolean;
    function  FindDealClass(ADBId: Integer): PRT_ClassDef_Rec;

    procedure InsertObject(Index: Integer; const ADbId: integer; ADealClass: PRT_ClassDef_Rec);
    //property  Items[Index: Integer]: Integer read GetItem write SetItem; default;
    property  StockPackCode[Index: Integer]: Integer read GetItemKey write SetItemKey; default;
    property  DealClass[Index: Integer]: PRT_ClassDef_Rec read GetDealClass write PutDealClass;
  end;
{$ENDIF}
  
implementation
             
{$IFDEF DEALCLASS} 
function TDealClassList.AddDealClass(const ADBId: integer; ADealClass: PRT_ClassDef_Rec): Integer;
begin
  if not Sorted then
  begin
    Result := FCount
  end else if FindIndex(ADBId, Result) then
  begin
    case Duplicates of
      lstDupIgnore: Exit;
      lstDupError: Error(@SALDuplicateItem, 0);
    end;
  end;
  InsertItem(Result, ADBId, ADealClass);
end;

{*****************************************************************************************}
procedure TDealClassList.InsertItem(Index: Integer; const ADBId: integer; ADealClass: PRT_ClassDef_Rec);
var
  tmpDealClassListItem: PDealClassListItem;
begin
  New(tmpDealClassListItem);
  tmpDealClassListItem^.DBId := ADBId;
  tmpDealClassListItem^.DealClass := ADealClass;
  try
    inherited InsertItem(index, tmpDealClassListItem);
  except
    Dispose(tmpDealClassListItem);
    raise;
  end;
end;

{***************************************************************************}
function TDealClassList.CompareItems(const Index1, Index2: integer): Integer;
begin
  result := PDealClassListItem(Get(Index1))^.DBId - PDealClassListItem(Get(Index2))^.DBId;
end;

{***********************************************************************}
function TDealClassList.FindIndex(ADbId: Integer; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := GetItemKey(I) - ADbId;
    if C < 0 then
    begin
      L := I + 1
    end else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        if Duplicates <> lstDupAccept then
          L := I;
      end;
    end;
  end;
  Index := L;
end;

function TDealClassList.FindDealClass(ADBId: Integer): PRT_ClassDef_Rec;   
var
  L, H, I, C: Integer;
  tmpItem: PDealClassListItem;
begin
  Result := nil;   
  L := 0;
  H := FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    tmpItem := PDealClassListItem(Get(I));
    C := tmpItem.DBId - ADbId;
    if C < 0 then
    begin
      L := I + 1
    end else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := tmpItem.DealClass;
        Break;
      end;
    end;
  end;
end;
{*******************************************************}
function TDealClassList.GetItemKey(AIndex: Integer): Integer;
begin
  Result := PDealClassListItem(Get(AIndex))^.DbId
end;

{******************************************************}
function TDealClassList.IndexOf(ADbId: Integer): Integer;
begin
  if not Sorted then
  Begin
    Result := 0;
    while (Result < FCount) and (GetItemKey(result) <> ADbId) do
      Inc(Result);
    if Result = FCount then
      Result := -1;
  end else
  begin
    if not FindIndex(ADbId, Result) then
      Result := -1;
  end;
end;
{*******************************************************************************************}
procedure TDealClassList.InsertObject(Index: Integer; const ADbId: integer; ADealClass: PRT_ClassDef_Rec);
var
  tmpDealClassListItem: PDealClassListItem;
begin
  New(tmpDealClassListItem);
  tmpDealClassListItem^.DbId := ADbId;
  tmpDealClassListItem^.DealClass := ADealClass;
  try
    inherited insert(index, tmpDealClassListItem);
  except
    Dispose(tmpDealClassListItem);
    raise;
  end;
end;

{***********************************************************************}
procedure TDealClassList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  if Action = lstDeleted then
    dispose(ptr);
  inherited Notify(Ptr, Action);
end;

{********************************************************************}
procedure TDealClassList.SetItemKey(AIndex: Integer; const ADbId: Integer);
Var
  tmpListItem: PDealClassListItem;
begin
  New(tmpListItem);
  tmpListItem^.DbId := ADbId;
  tmpListItem^.DealClass := nil;
  try
    Put(AIndex, tmpListItem);
  except
    Dispose(tmpListItem);
    raise;
  end;
end;

{*********************************************************}
function TDealClassList.GetDealClass(Index: Integer): PRT_ClassDef_Rec;
begin
  if (Index < 0) or (Index >= FCount) then
    Error(@SALListIndexError, Index);
  Result :=  PDealClassListItem(Get(index))^.DealClass;
end;

{***************************************************************}
function TDealClassList.IndexOfDealClass(ADealClass: PRT_ClassDef_Rec): Integer;
begin
  for Result := 0 to Count - 1 do
  begin
    if GetDealClass(Result) = ADealClass then
    begin
      Exit;
    end;
  end;
  Result := -1;
end;

{*******************************************************************}
procedure TDealClassList.PutDealClass(Index: Integer; ADealClass: PRT_ClassDef_Rec);
begin
  if (Index < 0) or (Index >= FCount) then
    Error(@SALListIndexError, Index);
  PDealClassListItem(Get(index))^.DealClass := ADealClass;
end;
{$ENDIF}

end.
